Цель

Исследовать данные о поведении пользователей онлайн-кинотеатра KION, используя статистические методы.

Задача

Познакомить читателя с данными и сделать выводы о пользователях онлайн-кинотеатра КИОН. Для анализа использовать переменные: age, income, total_dur, rating_kp, sex. Проанализировать каждую переменную, которую будем использовать для выполнения заданий.

1. Описание данных

Описание данных

Датасет включает в себя информацию о взаимодействии пользователей с контентом, демографическую информация о пользователях и мета-информацию о фильмах. Данные собраны на основе анализа пользователей сервиса в период с 13 марта 2021 года по 22 августа 2022 года.

Загружаем данные (в формате CSV) в датафрейм

df = read.csv('task_data.csv')
head(df, 1)

##   user_id item_id last_watch_dt total_dur watched_pct    X content_type
## 1  176549    9506    2021-05-11      4250          72 1571         film
##             title title_orig release_year                           genres
## 1 Холодное сердце     Frozen         2013 фэнтези, мультфильм, музыкальные
##   countries for_kids age_rating studios              directors
## 1       США       NA          0         Крис Бак, Дженнифер Ли
##                                                                                                                                                                                                                      actors
## 1 Кристен Белл, Идина Мензел, Джонатан Грофф, Джош Гад, Сантино Фонтана, Алан Тьюдик, Киран Хайндс, Крис Уильямс, Стивен Дж. Андерсон, Майа Уилсон, Киаран Хиндс, Морис ЛаМарш, Дженнифер Ли, Дара МакГарри, Фред Татаскьор
##                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                description
## 1 Когда сбывается древнее предсказание, и королевство погружается в объятия вечной зимы, трое бесстрашных героев — принцесса Анна, отважный Кристофф и его верный олень Свен — отправляются в горы, чтобы найти сестру Анны, Эльзу, которая может снять со страны леденящее заклятие. По пути их ждет множество увлекательных сюрпризов и захватывающих приключений: встреча с мистическими троллями, знакомство с очаровательным снеговиком по имени Олаф, горные вершины покруче Эвереста и магия в каждой снежинке. Анне и Кристоффу предстоит сплотиться и противостоять могучей стихии, чтобы спасти королевство и тех, кто им дорог.
##                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                   keywords
## 1 королева, мюзикл, принцесса, предательство, снеговик, олень, проклятие, снег, тролль, альпинист, сцена после титров, женщина-режиссёр, 3d, 3D, CGI-анимация, Альпинист, Антропоморфизм, Арестованный злодей, Бальные танцы, Блокбастер, Блочный лед, Броня, Владелец магазина, Водный фонтан, Волк, Волшебная сила, Волшебство, Ганс Христиан Андерсен, Героиня, Главный герой - женщина, Гора, Государственная измена, Девочка, Дисней, Дровосек, Езда на лошади, Женщина-герой, Женщина-режиссёр, Жертвоприношение, Замок, Замороженный заживо, Зима, Изоляция, Книга, Комический персонаж, Кораблекрушение, Королева, Королевство, Коронация, Лассо, Лед, Лес, Ложное обвинение, Любовь сестры, Маяк, Между жизнью и смертью (клиническая смерть), Монстр, Морковь, Музыка к фильму в исполнении оркестра, Название, сказанное персонажем, Настоящая любовь, Нет титров в начале фильма, Обман, Обман смерти, Обрыв, Оригинальное название из одного слова, Отношения сестёр, Отчаяние, Отшельник (аскет), Падение в воду, Пение, Первая часть, Перчатки, Пила, По мотивам сказки, Подсматривание в замочную скважину, Предатель, Предательство, Предложение вступить в брак, Преследуемый волками, Принц, Принцесса, Путешествие, Родные братья и сестры, Самопожертвование, Санки, Сарай, Сверхъестественные способности, Северное полярное сияние, Северный олень, Сестра, Сирота, Сказка, Склад, Смерть родителей, Снег, Снеговик, Снежная буря, Страстное увлечение, Сцена после финальных титров, Сцена, где рот закрывают ладонью, Счастливый конец, 2013, соединенные штаты, холодное, сердце
##       valid_from_dttm rating_kp       age       income sex kids_flg
## 1 2019-11-01 13:00:00           age_35_44 income_40_60   М        0

Посмотрим на размер датафрейма

dim(df)

## [1] 15768    25

В данных 15768 наблюдений (строк) и 25 переменных (столбцов)

Описание переменных

Посмотрим на переменные и их типы

str(df, vec.len = 2)

Переменная	Тип данных	Описание
`user_id`	int	ID пользователя
`age`	chr	возрастная группа пользователя 18_24 — от 18 до 24 лет включительно 25_34 — от 25 до 34 лет включительно 35_44 — от 35 до 44 лет включительно 45_54 — от 45 до 54 лет включительно 55_64 — от 55 до 64 лет включительно 65_inf — от 65 и старше
`sex`	chr	пол пользователя М — мужчина Ж — женщина
`income`	chr	доход пользователя income_0_20 - от 0 до 20000 р. income_20_40 - от 20000 до 40000 р. income_40_60 - от 40000 до 60000 р. income_60_90 - от 60000 до 90000 р. income_90_150 - от 90000 до 150000 р. income_150_inf - более 150000 р.
`kids_flg`	int	флаг «наличие ребенка»
`item_id`	int	ID контента
`content_type`	chr	тип контента (фильм, сериал)
`title`	chr	название на русском
`title_orig`	chr	название оригинальное
`genres`	chr	жанры из источника (онлайн-кинотеатры)
`countries`	chr	страны
`for_kids`	int	флаг «контент для детей»
`age_rating`	int	возрастной рейтинг
`studios`	chr	студии
`directors`	chr	режиссеры
`actors`	chr	актеры
`keywords`	chr	ключевые слова
`description`	chr	описание
`valid_from_dttm`	chr	дата, с которой контент доступен на KION
`rating_kp`	chr	рейтинг на Кинопоиске
`last_watch_dt`	chr	дата последнего просмотра
`total_dur`	int	общая продолжительность всех просмотров данного контента в секундах
`watched_pct`	int	-
`X`	int	-
`release_year`	int	год релиза

Уникальные значения

Найдем, сколько уникальных пользователей, фильмов и взаимодействий содержится в датасете

print(paste("Уникальных пользователей:", length(unique(df$user_id))))

## [1] "Уникальных пользователей: 15238"

print(paste("Уникальных фильмов / сериалов:", length(unique(df$item_id))))

## [1] "Уникальных фильмов / сериалов: 3204"

print(paste("Уникальных взаимодействия:", nrow(unique(df[c("user_id", "item_id")]))))

## [1] "Уникальных взаимодействия: 15768"

Описательные статистики

Чтобы в дальнейшем было удобнее работать с переменными, преобразуем их типы:

rating_kp (рейтинг на Кинопоиске) из character (символьный тип данных) в numeric (числовой тип данных)
sex (пол пользователя), age (возраст), income (доход) и content_type (тип контента) из character в factor (категориальный)

library(readr)

df$rating_kp <- as.numeric(parse_number(df$rating_kp, locale = locale(decimal_mark = ",")))

df$sex <- factor(df$sex, levels = c("Ж", "М"))
df$age <- factor(df$age, levels = c("age_18_24", "age_25_34", "age_35_44", "age_45_54", "age_55_64", "age_65_inf"), ordered = TRUE)
df$income <- factor(df$income, levels = c("income_0_20", "income_20_40", "income_40_60", "income_60_90", "income_90_150", "income_150_inf"), ordered = TRUE)
df$content_type <- factor(df$content_type, levels = c("film", "series"))

Посмотрим на количество пропусков в данных

library(naniar)

gg_miss_var(df)  # график пропусков по столбцам

Видим, что интересующие нас переменные sex, age, income и rating_kp содержат пропущенные значения. Избавимся от наблюдений с пропусками

library(dplyr)

df_clean <- df %>% 
  filter(!is.na(sex)) %>%
  filter(!is.na(age)) %>%
  filter(!is.na(income)) %>%
  filter(!is.na(rating_kp))

Рассчитаем описательные статистики для ключевых переменных

age (factor - качественная порядковая)
income (factor - качественная порядковая)
total_dur (int - количественная относительная)
rating_kp (numeric - количественная интервальная)
sex (factor - качественная номинальная)

Оценим, содержат ли количественные данные выбросы. Используем метод межквартильного размаха (IQR) из boxplot.stats

outliers_rating_kp <- boxplot.stats(df_clean$rating_kp)$out
outliers_total_dur <- boxplot.stats(df_clean$total_dur)$out

print(paste("Количество выбросов в переменной rating_kp:", length(outliers_rating_kp)))

## [1] "Количество выбросов в переменной rating_kp: 207"

print(paste("Количество выбросов в переменной total_dur:", length(outliers_total_dur)))

## [1] "Количество выбросов в переменной total_dur: 890"

Посмотрим, в каком диапазоне сосредоточены выбросные значения

print(paste("Диапазан выбросов в переменной rating_kp:", min(outliers_rating_kp), "-", max(outliers_rating_kp)))

## [1] "Диапазан выбросов в переменной rating_kp: 0 - 3.99"

print(paste("Диапазан выбросов в переменной total_dur:", min(outliers_total_dur), "-", max(outliers_total_dur)))

## [1] "Диапазан выбросов в переменной total_dur: 17106 - 3502510"

Выбросы в переменной rating_kp являются просто низкими значениями рейтинга, которых не слишком много в данных (207 значений из 10004). Мы оставим их в рассмотрении, уберем только оценки, равные 0
Выбросы в переменной total_dur - это очень большие значения (от 5 до 972 часов просмотра). Они могут сильно искажать распределение данных, что значимо для дальнейшего проведения статистических тестов. Также из данных стоит убрать слишком маленькие значения - менее 60 секунд

df_clean <- df_clean %>% 
  filter(rating_kp != 0, 
         between(total_dur, 60, min(outliers_total_dur) - 1)
  )

print(paste("Количество наблюдений после удаления пропущенных значений и выбросов:", nrow(df_clean)))

## [1] "Количество наблюдений после удаления пропущенных значений и выбросов: 7837"

Посмотрим на количество наблюдений каждой категории для порядковых переменных

print(summary(df_clean$age))

##  age_18_24  age_25_34  age_35_44  age_45_54  age_55_64 age_65_inf 
##       1038       2215       2247       1358        598        381

print(summary(df_clean$income))

##    income_0_20   income_20_40   income_40_60   income_60_90  income_90_150 
##            172           4427           2443            651            137 
## income_150_inf 
##              7

print(summary(df_clean$sex))

##    Ж    М 
## 3727 4110

Посмотрим на минимальные и максимальные значения количественных переменных

rating_kp

summary(df_clean$rating_kp)["Min."]

## Min. 
##  2.3

summary(df_clean$rating_kp)["Max."]

## Max. 
##  9.2

total_dur

summary(df_clean$total_dur)["Min."]

## Min. 
##   60

summary(df_clean$total_dur)["Max."]

##  Max. 
## 17066

Меры центральной тенденции:

Арифметическое среднее (количественные данные) для переменных rating_kp и total_dur

print(paste(round(mean(df_clean$rating_kp), digits = 2), "- средний балл рейтинга фильмов на Кинопоиске"))

## [1] "6.62 - средний балл рейтинга фильмов на Кинопоиске"

print(paste(round(mean(df_clean$total_dur)), "- средняя продолжительность всех просмотров контента (сек)"))

## [1] "4090 - средняя продолжительность всех просмотров контента (сек)"

Медиана (количественные и качественные порядковые) для переменных rating_kp, total_dur, age, income

# для количественных данных оценим медиану напрямую
print(paste(median(df_clean$rating_kp), "- серединное значение рейтинга фильмов на Кинопоиске"))

## [1] "6.7 - серединное значение рейтинга фильмов на Кинопоиске"

print(paste(median(df_clean$total_dur), "- серединное значение продолжительности всех просмотров контента (сек)"))

## [1] "3209 - серединное значение продолжительности всех просмотров контента (сек)"

# для порядковых данных оценим медиану с помощью квантиля уровня 0.5
print(paste(quantile(df_clean$age, probs = 0.5, type = 1), "- серединное значение возрастной группы пользователей"))

## [1] "age_35_44 - серединное значение возрастной группы пользователей"

print(paste(quantile(df_clean$income, probs = 0.5, type = 1), "- серединное значение дохода пользователей"))

## [1] "income_20_40 - серединное значение дохода пользователей"

Мода (любые качественные и количественные) для переменных age, income, total_dur, rating_kp и sex

library(modeest)

print(paste(mlv(df_clean$age, method = "mfv"), "- самая часто встречающаяся возрастная группа пользователей"))

## [1] "age_35_44 - самая часто встречающаяся возрастная группа пользователей"

print(paste(mlv(df_clean$income, method = "mfv"), "- самый часто встречающийся доход пользователей"))

## [1] "income_20_40 - самый часто встречающийся доход пользователей"

print(paste(mlv(df_clean$total_dur, method = "mfv"), "- самая часто встречающаяся продолжительность всех просмотров контента (сек)"))

## [1] "86 - самая часто встречающаяся продолжительность всех просмотров контента (сек)"

print(paste(mlv(df_clean$rating_kp, method = "mfv"), "- самый часто встречающийся рейтинг фильмов на Кинопоиске"))

## [1] "6.9 - самый часто встречающийся рейтинг фильмов на Кинопоиске"

print(paste(mlv(df_clean$sex, method = "mfv"), "- самый часто встречающийся пол пользователя"))

## [1] "М - самый часто встречающийся пол пользователя"

Распределения данных:

rating_kp

Гистограмма распределения

library(ggplot2)
library(plotly)

ggplotly(
  ggplot(df_clean, aes(x = rating_kp)) +
    geom_histogram(bins=8, fill = "orange", color = "#784e44") +
    scale_x_continuous(n.breaks = 8) +
    theme_minimal() +
    theme(panel.grid = element_blank()) +
    labs(title = "Распределение рейтинга фильмов на Кинопоиске",
         x = "Рейтинг (баллы)", 
         y = "Частота")
  )

Основная масса данных сосредоточена в диапазоне 6–8 баллов, с пиком около 7
Распределение имеет отрицательную асимметрию (левый хвост длиннее), так как есть низкие рейтинги с небольшой частотой
Низкие значения (2–3) встречаются редко, но присутствуют

Q-Q plot

qqnorm(df_clean$rating_kp, main = "Q-Q Plot для переменной rating_kp", col = "orange")
qqline(df_clean$rating_kp, col = "#784e44")

Основная часть данных приближена к нормальному распределению, но есть асимметрия у хвостов

Меры рассеяния

print(paste(round(max(df_clean$rating_kp) - min(df_clean$rating_kp), 2), "- разница между минимальным и максимальным значением (размах) рейтинга фильмов на Кинопоиске"))

## [1] "6.9 - разница между минимальным и максимальным значением (размах) рейтинга фильмов на Кинопоиске"

print(paste(round(var(df_clean$rating_kp), 2), "- дисперсия (баллов²)"))

## [1] "1.06 - дисперсия (баллов²)"

print(paste(round(sd(df_clean$rating_kp), 2), "- стандартное отклонение значений от среднего (корень из дисперсии)"))

## [1] "1.03 - стандартное отклонение значений от среднего (корень из дисперсии)"

total_dur

Гистограмма распределения

ggplotly(
  ggplot(df_clean, aes(x = total_dur)) +
    geom_histogram(bins = 20, fill = "lightblue", color = "#45818e") +
    theme_minimal() +
    theme(panel.grid = element_blank()) +
    labs(title = "Распределение продолжительности всех просмотров контента",
         x = "Продолжительность просмотра (сек)", 
         y = "Частота")
  )

Основная масса просмотров контента приходится на очень короткие промежутки времени, близкие к 1 минуте. Это указывает на то, что подавляющее большинство пользователей заканчивают просмотр очень быстро
Частота резко убывает с увеличением длительности просмотра, что указывает на правостороннее распределение (положительная асимметрия)

Q-Q plot

qqnorm(df_clean$total_dur, main = "Q-Q Plot для переменной total_dur", col = "lightblue")
qqline(df_clean$total_dur, col = "#45818e")

Точки заметно отклоняются от линии нормального распределения (особенно в хвостах)

Меры рассеяния

print(paste(round(max(df_clean$total_dur) - min(df_clean$total_dur), 2), "- разница между минимальным и максимальным значением (размах) продолжительности всех просмотров контента (сек)"))

## [1] "17006 - разница между минимальным и максимальным значением (размах) продолжительности всех просмотров контента (сек)"

print(paste(round(var(df_clean$total_dur)), "- дисперсия (сек²)"))

## [1] "14041400 - дисперсия (сек²)"

print(paste(round(sd(df_clean$total_dur)), "- стандартное отклонение значений от среднего (корень из дисперсии)"))

## [1] "3747 - стандартное отклонение значений от среднего (корень из дисперсии)"

Столбчатые диаграммы для частотного распределения категориальных данных

age

ggplotly(
  ggplot(df_clean, aes(x = age)) +
    geom_bar(fill = "#6aa84f", color = "#274e13") +
    theme_minimal() +
    theme(panel.grid = element_blank()) +
    labs(title = "Распределение возрастных групп пользователей",
         x = "Возраст", 
         y = "Количество")
  )

Наибольшие возрастные группы пользователей: 25–34 и 35-44 года с количеством пользователей около 2200 человек
Возрастные группы 55-64 и 65+ представлены в довольно небольшом количестве (менее 600 пользователей в каждой)

income

ggplotly(
  ggplot(df_clean, aes(x = income)) +
    geom_bar(fill = "#b4a7d6", color = "#674ea7") +
    theme_minimal() +
    theme(panel.grid = element_blank()) +
    labs(title = "Распределение дохода пользователей",
         x = "Доход (тысяч рублей)", 
         y = "Количество")
  )

Диапазон 20–40 тысяч рублей выделяется как самая многочисленная категория дохода пользователей
Группы с доходом 0–20, 90-150 и 150+ тысяч рублей имеют крайне небольшую численность

sex

ggplotly(
  ggplot(df_clean, aes(x = sex)) +
    geom_bar(fill = "#d5a6bd", color = "#a64d79") +
    theme_minimal() +
    theme(panel.grid = element_blank()) +
    labs(title = "Распределение пола",
         x = "Пол", 
         y = "Количество")
  )

Женщин в выборке немного меньше, чем мужчин. Однако группы относительно сбалансированы, нет экстремального перевеса одной категории над другой

2. Есть ли разница в продолжительности просмотра фильма в зависимости от дохода?

Гипотезы и выбор статистического теста

H₀ (нулевая гипотеза): Нет статистически значимой разницы в средней продолжительности просмотра контента между группами с разным уровнем дохода

H₁ (альтернативная гипотеза): Существует статистически значимая разница в средней продолжительности просмотра контента между хотя бы двумя группами с разным уровнем дохода

Поскольку в переменной income представлено 6 групп пользователей с различным уровнем дохода, будем использовать статистический тест для более двух независимых выборок (ANOVA / Краскела-Уоллиса)

Проверка допущений для ANOVA:

Нормальность распределения в каждой группе

# гистограммы распределения
ggplot(df_clean, aes(x = total_dur)) +
  geom_histogram(bins=10, fill = "lightblue", color = "#674ea7") +
  facet_wrap(~ income) +
  ggtitle("Распределение продолжительности просмотра (группы по доходу)") +
  labs(x = "Продолжительность просмотра (сек)",
       y = "Частота") +
  theme_minimal()

# тест Шапиро-Уилка
df_clean %>%
  group_by(income) %>%
  summarise(
    p.value = shapiro.test(total_dur)$p.value
  )

## # A tibble: 6 × 2
##   income          p.value
##   <ord>             <dbl>
## 1 income_0_20    4.82e-11
## 2 income_20_40   1.04e-48
## 3 income_40_60   9.60e-38
## 4 income_60_90   8.63e-21
## 5 income_90_150  5.31e- 9
## 6 income_150_inf 1.35e- 2

# qq-plot
ggplot(df_clean, aes(sample = total_dur)) +
  stat_qq(col = "lightblue") +
  stat_qq_line(col = "#674ea7") +
  facet_wrap(~ income) +
  ggtitle("QQ-plot продолжительности просмотра (группы по доходу)") +
  theme_minimal()

Вновь убеждаемся, что данные в total_dur далеки от нормального распределения, даже при разбиении их на группы по доходу пользователей. Поэтому нам необходимо использовать непараметрический аналог ANOVA - тест Краскела-Уоллиса

Равенство дисперсий

library(car)

# тест Левена
leveneTest(total_dur ~ income, data = df_clean)

## Levene's Test for Homogeneity of Variance (center = median)
##         Df F value  Pr(>F)  
## group    5  2.8369 0.01454 *
##       7831                  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Однако видим, что по результатам теста Левена, мы получили p-value = 0.0145. (> заданного уровня значимости 0.05). На основе этого, можем сделать вывод о равенстве дисперсий в группах

Тест Краскела-Уоллиса

kruskal.test(total_dur ~ income, data = df_clean)

## 
##  Kruskal-Wallis rank sum test
## 
## data:  total_dur by income
## Kruskal-Wallis chi-squared = 9.295, df = 5, p-value = 0.09786

По результатам теста Краскела-Уоллиса: p-value = 0.0979 (> заданного уровня значимости 0.05), значит мы НЕ можем отвергнуть нулевую гипотезу. Средняя продолжительность просмотра контента между группами с разным уровнем дохода НЕ имеет статистически значимых различий

Описательная статистика

Посмотрим на медианы, квартили и кол-во наблюдений для каждой группы

df_clean %>%
  group_by(income) %>%
  summarise(
    median = median(total_dur),
    Q1 = quantile(total_dur, 0.25),
    Q3 = quantile(total_dur, 0.75),
    n = n()
  )

## # A tibble: 6 × 5
##   income         median    Q1     Q3     n
##   <ord>           <dbl> <dbl>  <dbl> <int>
## 1 income_0_20     3066.  663   6512.   172
## 2 income_20_40    3089   675   6496.  4427
## 3 income_40_60    3449   764.  6624.  2443
## 4 income_60_90    3306   800.  6850    651
## 5 income_90_150   3837   875   7472    137
## 6 income_150_inf   613   351  10689      7

Действительно видим, что медиана и значение других квартилей не слишком отличаются в разных группах. Видим более существенное отличие только для группы с income_150_inf, однако в силу небольшого количества измерений (7 штук), нельзя говорить о его статистической значимости

Визуализация

ggplot(df_clean, aes(x = income, y = total_dur)) +
  geom_boxplot(fill = "lightblue", color = "#674ea7") +
  labs(title = "Продолжительность просмотра в зависимости от дохода",
         x = "Доход (тысяч рублей)", 
         y = "Продолжительность просмотра (сек)") +
  theme_minimal()

3. Различается ли средняя продолжительность просмотров фильмов между мужчинами и женщинами?

Гипотезы и выбор статистического теста

H₀ (нулевая гипотеза): Между женщинами и мужчинами нет статистически значимой разницы в средней продолжительности просмотра контента

H₁ (альтернативная гипотеза): Между женщинами и мужчинами существует статистически значимая разница в средней продолжительности просмотра контента

Поскольку нам предстоит анализировать две группы пользователей (Ж и М), будем использовать статистический тест для двух независимых выборок (t-Стьюдента / U-Манна-Уитни)

Проверка допущений для t-теста:

Нормальность распределения в каждой группе

# гистограммы распределения
ggplot(df_clean, aes(x = total_dur)) +
  geom_histogram(bins = 10, fill = "lightblue", color = "#a64d79") +
  facet_wrap(~ sex) +
  ggtitle("Распределение продолжительности просмотра (группы по полу)") +
  labs(x = "Продолжительность просмотра (сек)",
       y = "Частота") +
  theme_minimal()

# тест Шапиро-Уилка
df_clean %>%
  group_by(sex) %>%
  summarise(
    p.value = shapiro.test(total_dur)$p.value
  )

## # A tibble: 2 × 2
##   sex    p.value
##   <fct>    <dbl>
## 1 Ж     2.13e-45
## 2 М     4.48e-47

# qq-plot
ggplot(df_clean, aes(sample = total_dur)) +
  stat_qq(col = "lightblue") +
  stat_qq_line(col = "#a64d79") +
  facet_wrap(~ sex) +
  ggtitle("QQ-plot продолжительности просмотра, сгруппированные по полу") +
  theme_minimal()

Данные о продолжительности просмотра контента в зависимости от пола не соответствуют нормальному распределению. Поэтому нам необходимо использовать непараметрический аналог t-теста Стьюдента - тест Манна-Уитни

Равенство дисперсий

# тест Левена
leveneTest(total_dur ~ sex, data = df_clean)

## Levene's Test for Homogeneity of Variance (center = median)
##         Df F value Pr(>F)
## group    1  2.0781 0.1495
##       7835

По результатам теста Левена, p-value = 0.1495. (> заданного уровня значимости 0.05), что свидетельствует о равенстве дисперсий в двух выборках

Тест Манна-Уитни

wilcox.test(total_dur ~ sex, data = df_clean)

## 
##  Wilcoxon rank sum test with continuity correction
## 
## data:  total_dur by sex
## W = 7768864, p-value = 0.272
## alternative hypothesis: true location shift is not equal to 0

По результатам теста Манна-Уитни: p-value = 0.272 (> заданного уровня значимости 0.05), значит мы принимаем нулевую гипотезу. Средняя продолжительность просмотра контента между женщинами и мужчинами НЕ имеет статистически значимых различий

Описательная статистика

Медианы, квартили и кол-во наблюдений для каждой группы

df_clean %>%
  group_by(sex) %>%
  summarise(
    median = median(total_dur),
    Q1 = quantile(total_dur, 0.25),
    Q3 = quantile(total_dur, 0.75),
    n = n()
  )

## # A tibble: 2 × 5
##   sex   median    Q1    Q3     n
##   <fct>  <dbl> <dbl> <dbl> <int>
## 1 Ж       3277   732 6662.  3727
## 2 М       3147   707 6541   4110

Данные о продолжительности просмотра слегка выше для женщин, однако различия не значимы

Визуализация

ggplot(df_clean, aes(x = sex, y = total_dur)) +
  geom_boxplot(fill = "lightblue", color = "#a64d79") +
  labs(title = "Продолжительность просмотра в зависимости от пола",
         x = "Пол", 
         y = "Продолжительность просмотра (сек)") +
  theme_minimal()

4. Связан ли рейтинг фильма на Кинопоиске и продолжительность просмотра фильмов?

Гипотезы и выбор статистического теста

H₀ (нулевая гипотеза): Нет статистически значимой связи между рейтингом фильма на Кинопоиске и продолжительностью его просмотра

H₁ (альтернативная гипотеза): Существует статистически значимая связь между рейтингом фильма на Кинопоиске и продолжительностью его просмотра

Поскольку нам нужно оценить степень взаимосвязи между двумя переменными, будем использовать корреляционный анализ (коэффициент Пирсона, Спирмана или Кендалла)

Проверка допущений для корреляции Пирсона

Тип шкалы

Обе переменные являются количественными:

rating_kp - интервальная, поскольку позволяет измерять разницу между значениями, но не имеет абсолютного нуля
total_dur - относительная, т.к. может иметь абсолютный ноль, который означает полное отсутствие измеряемого признака

Нормальность распределения каждой переменной

library(gridExtra)

# гистограммы распределения
grid.arrange(
  ggplot(df_clean, aes(x = rating_kp)) +
    geom_histogram(bins=8, fill = "orange", color = "#784e44") +
    scale_x_continuous(n.breaks = 8) +
    theme_minimal() +
    labs(title = "Распределение рейтинга\nфильмов на Кинопоиске",
         x = "Рейтинг (баллы)", 
         y = "Частота"), 
  
  ggplot(df_clean, aes(x = total_dur)) +
    geom_histogram(bins = 15, fill = "lightblue", color = "#45818e") +
    theme_minimal() +
    labs(title = "Распределение продолжительности\nпросмотров контента",
         x = "Продолжительность просмотра (сек)", 
         y = "Частота"),
  
  ncol=2
)

# Q-Q plot
grid.arrange(
  ggplot(df_clean, aes(sample = rating_kp)) +
    stat_qq(color = "orange") +
    stat_qq_line(col = "#784e44") +
    labs(title = "Q-Q Plot для rating_kp") +
    theme_minimal(),
  
  ggplot(df_clean, aes(sample = total_dur)) +
    stat_qq(color = "lightblue") +
    stat_qq_line(col = "#45818e") +
    labs(title = "Q-Q Plot для total_dur") +
    theme_minimal(),
  
  ncol = 2
)

Поскольку выборка слишком большая для проведения классического теста Шапиро-Уилка, используем тест Андерсона-Дарлинга (для n > 5000)

library(nortest)

print(ad.test(df_clean$rating_kp))

## 
##  Anderson-Darling normality test
## 
## data:  df_clean$rating_kp
## A = 45.444, p-value < 2.2e-16

print(ad.test(df_clean$total_dur))

## 
##  Anderson-Darling normality test
## 
## data:  df_clean$total_dur
## A = 243.7, p-value < 2.2e-16

Так как обе переменные не распределены нормально, коэффициент Пирсона нам НЕ подходит, используем непараметрический аналог - коэффициент корреляции Спирмена или Кендалла

Проверка на выбросы

grid.arrange(
  ggplot(df_clean, aes(y = rating_kp)) + 
    geom_boxplot(fill = "orange", color = "#784e44") +
    labs(title = "Boxplot для переменной rating_kp") +
    theme_minimal(),
  
  ggplot(df_clean, aes(y = total_dur)) + 
    geom_boxplot(fill = "lightblue", color = "#45818e") +
    labs(title = "Boxplot для переменной total_dur") +
    theme_minimal(),
  
  ncol = 2
)

Несмотря на то, что мы уже избавлялись от выбросных значений, в них все еще присутствуют выбросы. Таким образом, лучше использовать коэффициент корреляции Кендалла, который к ним более устойчив

Тест корреляции Кендалла

cor.test(df_clean$rating_kp, df_clean$total_dur, method = "kendall")

## 
##  Kendall's rank correlation tau
## 
## data:  df_clean$rating_kp and df_clean$total_dur
## z = 1.2928, p-value = 0.1961
## alternative hypothesis: true tau is not equal to 0
## sample estimates:
##         tau 
## 0.009862392

Значение tau близко к нулю (0.009), что указывает на практически полное отсутствие линейной связи между рейтингом фильмов и длительностью их просмотра
p-value = 0.1961 (больше 0.05) подтверждает, что наблюдаемая очень слабая корреляция не является статистически значимой

Визуализация

library(ggpubr)

# точечная диаграмма с линией регрессии
ggscatter(df_clean, x = "rating_kp", y = "total_dur",
          add = "reg.line", conf.int = FALSE, cor.method = "kendall",
          size = 3, shape = 21, 
          color = "lightblue", fill = "orange",
          xlab = "Рейтинг на Кинопоиске", ylab = "Продолжительность просмотора (сек) -\nлогарифмированная",
          title = "Корреляция рейтинга и продолжительности просмотра"
) + scale_y_log10() # логарифмическая шкала для сильно скошенных данных

# плотность распределения
ggplot(df_clean, aes(x = rating_kp, y = total_dur)) +
  geom_hex(bins = 30) +
  geom_smooth(formula = y ~ x, method = "lm", color = "orange", se = FALSE) +
  scale_y_log10() +
  labs(title = "Плотность распределения продолжительности просмотра по рейтингу", x = "Рейтинг на Кинопоиске", y = "Продолжительность просмотора (сек) -\nлогарифмированная") +
  theme_minimal()

# Boxplot для распределения времени просмотра по разным рейтингам (значение рейтинга округлено)
ggplot(df_clean, aes(x = factor(round(rating_kp)), y = total_dur)) +
  geom_boxplot(fill = "orange", color = "#45818e") +
  labs(title = "Продолжительность просмотра по рейтингу", x = "Округленный рейтинг", y = "Продолжительность просмотора (сек)") +
  theme_minimal()

5. Связан ли пол пользователя и тип контента, который он просматривает?

Гипотезы и выбор статистического теста

H₀ (нулевая гипотеза): Между полом пользователя и типом контента, который он просматривает, отсутствует сатистически значимая связь

H₁ (альтернативная гипотеза): Существует статистически значимая свзяь между полом пользователя и типом контента, который он просматривает

Так как мы хотим проверить, есть ли связь между двумя категориальными переменными, используем тест Хи-квадрат на независимость или тест Фишера

Проверка допущений для Хи-квадрат

Допущения о независимости переменных и количестве наблюдений (7837) соблюдены

Создадим таблицу сопряженности переменных sex и content_type

contingency_table <- table(df_clean$sex, df_clean$content_type)
contingency_table

##    
##     film series
##   Ж 2990    737
##   М 3520    590

Проверим ожидаемые частоты

chisq <- chisq.test(contingency_table)
round(chisq$expected)

##    
##     film series
##   Ж 3096    631
##   М 3414    696

Видим, что условие соблюдено - все значения ≥5, можно использовать тест Хи-квадрат на независимость

Тест Хи-квадрат

chisq

## 
##  Pearson's Chi-squared test with Yates' continuity correction
## 
## data:  contingency_table
## X-squared = 40.429, df = 1, p-value = 2.039e-10

p-value = 2.039e-10 < 0.05: Отвергаем H₀, связь между полом и типом контента статистически значима

Посмотрим на направление связи (стандартизированные остатки)

round(chisq$stdres)

##    
##     film series
##   Ж   -6      6
##   М    6     -6

Все отклонения = 6 (по модулю), а значит можно считать их очень сильными (> 3)

У женщин наблюдаемая частота просмотра сериалов (series) на 6 выше, а у мужчин на 6 ниже ожидаемой, значит, женщины чаще смотрят сериалы, чем мужчины
У женщин наблюдаемая частота просмотра фильмов на 6 ниже ожидаемой, а у мужчин на 6 выше ожидаемой, значит, мужчины чаще смотрят фильмы, чем женщины

Визулизация

# мозаичная диаграмма
mosaicplot(contingency_table,
           main = "Связь пола и типа контента",
           xlab = "Пол", 
           ylab = "Тип контента",
           col = c("#8fce00", "#674ea7"))

# столбчатая диаграмма

ggplot(as.data.frame(contingency_table), aes(x = Var1, y = Freq, fill = Var2)) +
  geom_bar(stat = "identity", position = "dodge") +
  labs(x = "Пол", y = "Количество", fill = "Тип контента") +
  scale_fill_manual(values = c("film" = "#8fce00", "series" = "#674ea7")) +
  theme_minimal()

library(corrplot)

# визуализируем остатки
corrplot(chisq$residuals, method = "circle", type = "full", is.cor=FALSE)

6. Отличаются ли предпочтения пользователей в типе просматриваемого контента в зависимости от уровня дохода?

Гипотезы и выбор теста

H₀ (нулевая гипотеза): Между типом контента, который просматривает пользователь, и уровнем его дохода отсутствует статистически значимая связь

H₁ (альтернативная гипотеза): Существует статистически значимая свзяь между типом контента, который просматривает пользователь, и уровнем его дохода

Проверка допущений для Хи-квадрат

Допущения о независимости переменных и количестве наблюдений (7837) соблюдены

Создадим таблицу сопряженности переменных income и content_type

contingency_table <- table(df_clean$income, df_clean$content_type)
contingency_table

##                 
##                  film series
##   income_0_20     124     48
##   income_20_40   3707    720
##   income_40_60   2031    412
##   income_60_90    536    115
##   income_90_150   108     29
##   income_150_inf    4      3

Проверим ожидаемые частоты

chisq <- chisq.test(contingency_table)
round(chisq$expected)

##                 
##                  film series
##   income_0_20     143     29
##   income_20_40   3677    750
##   income_40_60   2029    414
##   income_60_90    541    110
##   income_90_150   114     23
##   income_150_inf    6      1

Видим, что условие соблюдено - все значения (кроме series для income_150_inf) ≥5, будем использовать Хи-квадрат на независимость

Тест Хи-квадрат

chisq

## 
##  Pearson's Chi-squared test
## 
## data:  contingency_table
## X-squared = 21.484, df = 5, p-value = 0.0006561

p-value = 0.0007 < 0.05: Отвергаем H₀, связь между доходом и типом контента статистически значима

Посмотрим на направление связи (стандартизированные остатки)

round(chisq$stdres)

##                 
##                  film series
##   income_0_20      -4      4
##   income_20_40      2     -2
##   income_40_60      0      0
##   income_60_90     -1      1
##   income_90_150    -1      1
##   income_150_inf   -2      2

У пользователей с доходом от 0 до 20000 р. самое сильное отклонение от ожидаемого (4) - они чаще смотрят сериалы, чем пользователи с другим доходом
Пользователи с доходом от 20000 до 40000 р. также имеют довольно значительное отклонение (2) - они, наоборот, чаще смотрят фильмы, чем пользователи с другим доходом
Пользователи с доходом от 150000 р. (отклонение = 2) чаще смотрят сериалы, чем пользователи с другим доходои
Для пользователей с доходом от 40000 до 60000 р. фактическое наблюдение совпало с ожидаемым (0); для групп от 60000 до 150000 р. отклонения также были незначимым (1), что говорит об отсутствии конкретных предпочтений для этих групп

Визулизация

# столбчатая диаграмма

ggplot(as.data.frame(contingency_table), aes(x = Var1, y = Freq, fill = Var2)) +
  geom_bar(stat = "identity", position = "dodge") +
  labs(x = "Доход", y = "Количество", fill = "Тип контента") +
  scale_fill_manual(values = c("film" = "#8fce00", "series" = "#674ea7")) +
  theme_minimal()

# визуализируем остатки
corrplot(chisq$residuals, method = "circle", type = "full", is.cor=FALSE)

Анализ пользовательского поведения в KION

Горчинская Арина

2025-04-05

Цель

Задача

1. Описание данных

Описание данных

Описание переменных

Уникальные значения

Описательные статистики

2. Есть ли разница в продолжительности просмотра фильма в зависимости от дохода?

Гипотезы и выбор статистического теста

Проверка допущений для ANOVA:

Тест Краскела-Уоллиса

Описательная статистика

Визуализация

3. Различается ли средняя продолжительность просмотров фильмов между мужчинами и женщинами?

Гипотезы и выбор статистического теста

Проверка допущений для t-теста:

Тест Манна-Уитни

Описательная статистика

Визуализация

4. Связан ли рейтинг фильма на Кинопоиске и продолжительность просмотра фильмов?

Гипотезы и выбор статистического теста

Проверка допущений для корреляции Пирсона

Тест корреляции Кендалла

Визуализация

5. Связан ли пол пользователя и тип контента, который он просматривает?

Гипотезы и выбор статистического теста

Проверка допущений для Хи-квадрат

Тест Хи-квадрат

Визулизация

6. Отличаются ли предпочтения пользователей в типе просматриваемого контента в зависимости от уровня дохода?

Гипотезы и выбор теста

Проверка допущений для Хи-квадрат

Тест Хи-квадрат

Визулизация